perm filename MRK.OLD[P11,LCS] blob sn#583817 filedate 1981-05-05 generic text, type T, neo UTF8
	SUBROUTINE MRK
	COMMON /INTGRS/JACC,JTAIL,MRK,NTYPE,JSTEM,JWHOLE
	COMMON/DAT/RACNT(69),RDT(17),NXAC(7)
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSTFAC(0/7),RSTJ2
	COMMON /FONT/JFONT /PLTR/IPLT,RHT /POSI/STFF(0/7),JJ2,POS
	COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
	1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
	EQUIVALENCE (R3,RJQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(R11,RJQ(9))
	1,(R4,RJQ(2)),(RLVL,RJQ(20)),(R6,RJQ(4)),(J11,JQ(9))

	RX=RMINI
	RINV=1.0
	MRK=J11/100
C GET MARK CLOSEST TO NOTE HEAD.
	J5=J11-MRK
	R11=AMOD(R11,1.0)*7.*RMINI
C SHIFT AWAY FROM NORMAL VERTICAL POS.
	IF(J5.LT.27)GO TO 1
	IF(J5.LE.28)CALL EXCH(J5,MRK)
C ALL THIS FOR TEN.-STAC. COMBO (=27) ALSO WEDGE-STAC.
1	R4=RLVL
	R3=RJAC
	J4=R4
	JX=1
CC	IF(J5.GT.16)GO TO 2222
C  JUMP FOR MORD, INV.MORD, TRILL
1250	RB=14.
	IF(MOD(J4,2).EQ.0)GO TO 244
	IF(J5.EQ.7)GO TO 6322
	IF(J5.NE.9)GO TO 244
6322  IF(JSTEM.GT.1)GO TO 7322
	IF(J4.LT.5)GO TO 244
7322  IF(J4.LE.9)GO TO 8322
	IF(JSTEM.EQ.2)GO TO 244
	IF(JSTEM.EQ.0)GO TO 244
8322  RB=21.
C   PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
244   IF(JSTEM.EQ.1)GO TO 9322
	IF(JSTEM.NE.0)GO TO 245
	IF(J4.GE.7)GO TO 245
9322  RB=-RB
245   CENTR=CENTR+RB*RSTJ2
CC245   CENTR=CENTR+RB*RSTX
	R11=0
250   IF(J5.GT.10)GO TO 281
	IF(J5.LT.6)GO TO 281
	JA=9
	IF(J5.NE.7)GO TO 253
C   7=DOT
	RXX=R3
	R3=R3+6.7*RMINI
C   CENTERS THE DOT
29	RJY=CENTR+RSTJ2
	RG=9.
	IF(IPLT.LT.0)RG=17.
	CALL RDRAW(1,RG,RDOT,RMINI,R3,RJY,RMINI)
	GO TO 6241
253   IF(J5.EQ.9)GO TO 271
C   9=DASH
251   IF(RB.LT.0)RINV=-RINV
2222	IF(R11.EQ.0)GO TO 12222
C   FIX THIS!!!!  FOR BOWINGS, ETC.
	CENTR=CENTR+R11
	R4=R4+CENTR/7.
C  GET DISPLACEMENT IN SCALE STEPS. 	;ADD TO HEIGHT
	R11=0
	IF(JSTEM.EQ.1)R11=-R11  
C FOR WEDGE
	RX4=RX4-CENTR/7.

12222	IF(FICTA.NE.0)GO TO 2223
C SKIPE FICTA	;MUSICA FICTA FLAG (J5=21,22,23 SAME AS TR.)
	IF(J5.LT.20.OR.J5.GT.23)GO TO 2223
	JA=7
	R5=0
	J7=1
	CALL ALPHA
	R8=J5-20  
C (R8=1=FLT, 2=SHRP, 3=NAT)
C   FOR TRILL  -- J5=20
	RETURN    

2223	FICTA=0
	IF(J5.EQ.17)GO TO 323
	IF(J5.NE.18)GO TO 222
323   RINV=J5
C   FOR MORD, INV.MORD
222	CALL FERMTA
	GO TO 5241
246   IF(J5.LT.10)GO TO 245
C FOR COMBOS. TS=27, WS=28, AS=29.
	IF(J5.LT.27.OR.J5.GT.30)GO TO 1246
	TS=J5
C  TS IS FLAG FOR COMBOS
	J5=7
CC	MOVEI 7		; STACCATO COMES FIRST IN COMBOS
CC	JRST ATS
	GO TO 1250
C;	CAIN =28		;WS COMBO =28
C;	JRST AC246
C;	CAIE =27		;TS COMBO =27
C;	JRST AB246		;IF(J5.NE.27)GO TO AB246
C;AA246:	MOVEI =9	;TEN. COMES 1ST IF TEN.-STAC. COMBO
C;	SKIPA
C;AC246:	MOVEI =7	;STAC. COMES 1ST IF WEDGE-STAC. COMBO
C;	MOVEM TS		;TS=CODE     FLAG
C;	JRST ATS		; AC0=9  SETUP TENUTO FIRST
	
1246	RZ=3
C IS IT A FERMATA? 
	 IF(J5.EQ.26)RZ=2
C   RZ=2 **** MAKE FERMATA 1 LESS AWAY
	IF(JSTEM.EQ.1)RZ=8.+R8
C  IS IT A FERMATA? 
26	R4=R4+RZ*RMINI/RSTJ2

	RC=12.5
	IF(J5.EQ.26)RC=11.75
	IF(R4.LT.RC)R4=RC
	IF(J5.NE.26)GO TO 28
	CENTR=CENTR+R11
	GO TO 222
28	   IF(J5.LT.30)GO TO 281
C  PRINTS ONLY NUMS 0→5 AS FINGERINGS OVER NOTES.
	IF(J5.GE.36)GO TO 128
	R5=J5-30
C   GET THE 1 DIGIT NUM.
	RC=6.
	IF(JSTEM.NE.2)RC=8.
	JX3=JX3+RC*RSTJ2
	R7=0
	R8=0
	R9=0
	RA=2.5
	IF(JSTEM.EQ.1)RA=4.
	R4=J4+RA
C   HGT OF NUM.
	CALL MAKNUM(R5)
	RETURN
C ADD HERE FOR NUMS WITH ACCENTS, ETC.
128	J5X=MOD(J5,10)
C  J5X SAVES NEXT MARK.
	     IF(J5X.LT.4)J5X=0
      J5=J5/10
	     IF(J5.GT.30)RETURN
C  WON'T READ 415 ETC. (CORRECT=154)
C DOES BOTTOM MARK FIRST, THEN TOP.
	CALL EXCH(J5X,J5)
C  PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
 	 IF(JA.EQ.1)GO TO 249
1241	IF(J5.GE.11)GO TO 28
	GO TO(211,211,211,28,28,222,1250,60,27,27),J5
	RETURN
281    JX=1
	 IF(J5.GT.16)GO TO 2222
C  JUMP FOR MORD, INV.MORD, TRILL

	IF(J5.NE.4)GO TO 228
	JX=5
	CALL RJBX(.5)
	GO TO 328
228   IF(J5.GT.10)JX=NXAC(J5-10)
C  JX IS POINTER IN RACNT ARRAY
328   RA=RMINI
C   OR RSTJ2?
	IF(RINV.LT.0)GO TO 1323
	IF(JSTEM.NE.1)GO TO 2323
	IF(J5.NE.4)GO TO 2323
1323  RA=-RA
C  ↑↑↑ X ↑↑↑ PICKS UP TYPO ERRORS
2323	JTH=0
	IF(IPLT.LT.0)JTH=-2
11	RJJJ=CENTR+R11
C (DISPLACEMENT UNIT)
	IF(JX.LT.54)CALL RDRAW(JX+1,RACNT(JX),RACNT,RA,R3,CENTR,RMINI)
C                        PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
	IF(JTH.GE.0)GO TO 5241
4241  JJJ=J5
	JTH=JTH-1
	IF(J5.NE.13)GO TO 127
C 13=HARMONIC
	RMINI=RMINI+.02
	GO TO 11
127	IF(J5.EQ.14)R3=R3+XDIS
C 14= +
	CENTR=CENTR-XDIS 
C  TO THICKEN > - ∧ ETC. WHEN PLOTTING
	GO TO 11

4240	JJJ=J5
C  *****WHERE IS JJJ USED????***********
14241	J5=J5X
	J5X=-1
	IF(JAX.NE.1)GO TO 7241
CC	IF(J5.GT.10)GO TO 246
	IF(J5.NE.7)GO TO 7241
CC	IF(JJJ.NE.9)GO TO 249
7241  RXX=8.5*RMINI
	IF(J5.EQ.5)RXX=10.5*RMINI
C ACC. IS FARTHER FROM STAC. THAN WEDGE OR TEN.
C THIS IS FOR COMPOSITE MARKS (TEN.-STAC. ETC)
	IF(JSTEM.EQ.1)RXX=-RXX
	CENTR=CENTR+RXX
	IF(J5.EQ.26)J5=6
CC	GO TO 1241
C  >=5,  ↑=4
27    R3=J3
C  DASHES
271   CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
	IF(IPLT.LT.0)CALL LINX(R3,CENTR,TEMP,CENTR)
C MAKE THICKER IF PLOTTING
C CENTR=CENTR-XDIS  (1/DIS)
CC	GO TO 5240
5241	IF(J11.EQ.0)GO TO 25241
CC	IF(TS.LT.0)GO TO 15241
CC	IF(TS.EQ.CODE)AC0=7, RESET TS, GO TO B421
CC	J5=9
C  NOW GET TENUTO  (=9)
CC	IF(TS.EQ.28)J5=4
C ABOVE IS WEDGE    (FOR WS)
CC	IF(TS.EQ.29)J5=5
C ACCENT
CC	TS=-1
CC	GO TO 7241
C GO ARRANGE THE HEIGHT SHIFT

C J11=0 SO IT WILL PASS HERE SECOND TIME AROUND.
C R11=0  SO DOUBLE MARKS WON'T BE MOVED UP TWICE.
CC	GO TO 24241
25241  IF(J5X.GT.0)GO TO 14241
C J5X IS FOR DOUBLE MARKS.(WHAT ABOUT DOT POSITION.)
	RETURN
6241  R3=RXX
C  RESET R3 AFTER A DOT.
	GO TO 5241
3121  J5=J5+9
      CALL DRWNT
CC	GO TO 2422
	RETURN

C 4=WDG, 5=ACCNT, 7 STACC, 9=TEN, 11=DNBOW, 12=UPBOW, 13=HARM, 14=+
C 15=THESIS, 16=ARSIS, 17=MORD, 18= INVMORD, 20=TR, 21=Tb, 22=T#, 23=TNAT
C 25=HVYWDG, 26=FERM, 27=TEN-STACC, 28=WDG-STACC, 29=ACCNT-STACC
C 30-35=FINGERING, 21-23=MUSICA FICTA
249	IF(J5.GT.30)GO TO 28
	IF(J5.GT.10)GO TO 246
	IF(J5.EQ.0)RETURN
	GO TO 1250
	END